Tagging des indicateurs de santé
Philéas Condemine
11 mars 2019
Ce tutoriel pour le projet de tagging des indicateurs de santé est un vrai projet de bout en bout, de la préparation des données à la restitution de résultats.
Vous pouvez librement digresser au cours de l’étude et pour vous y encourager, 3 exercices vous sont proposés :
- appliquer des méthodes de calcul de distance entre chaînes de caractères pour identifier des indicateurs semblables et appliquer des techniques type k-NN
- modéliser le nombre de tags par indicateur
- finaliser une application shiny d’active learning
L’application de restitution est hors programme mais vous pouvez la consulter (ici)[https://drees.shinyapps.io/Cartographie_des_indicateurs/]
library(data.table)
library(stringi)
library(dplyr)
library(stringr)
library(text2vec)
library(readxl)
library(Matrix)
library(text2vec)
library(rdrop2)
library(ggplot2)
library(plotly)
library(magrittr)
library(slam)
library(stringdist)
library(xgboost)
# GESTION DE LA CONVERSION DES NOMBRES EN CHAINE DE CARACTERES SANS UTILISER LA NOTATION SCIENTIFIQUE
# https://stackoverflow.com/questions/5352099/how-to-disable-scientific-notation
options("scipen"=100, "digits"=10) Préparation des données
Base des indicateurs
Aperçu
data2 <- fread("data/29032018_Index2.csv",encoding="Latin-1")
nb_indicateurs=nrow(data2)Le jeu de données contient indicateurs.
Les données sont principalement textuelles, certaines peut-être plus exploitables que d’autres.
names(data2)## [1] "index"
## [2] "Base"
## [3] "Indicateur"
## [4] "Famille"
## [5] "Famille Finale_DREES"
## [6] "Classement producteur Niveau 3 (le plus détaillé)"
## [7] "Classement producteur Niveau 2"
## [8] "Classement producteur Niveau 1 (le moins détaillé)"
## [9] "thème_DREES"
## [10] "Domaine 1_DREES"
## [11] "Domaine 2_DREES"
## [12] "Domaine 3_DREES"
## [13] "Source"
## [14] "Producteur"
## [15] "Echelle géo. nationale"
## [16] "Echelle géo. Rég"
## [17] "Echelle géo dep"
## [18] "Autre échelle de restitution"
## [19] "Profondeur historique"
## [20] "Fréquence d'actualisation"
## [21] "Commentaires"
## [22] "Base"
## [23] "Date version base"
## [24] "Type d'accès"
## [25] "Accéder à la base"
## [26] "Producteur de la base"
## [27] "index"head(data2)#Un View(head(data2,100)) sera peut-être plus approprié pour vous.Variables doublons
La variable index est présente deux fois !
On vérifie que c’est bien les mêmes valeurs les deux fois puis on supprime
data2[c(!data2[,1]==data2[,27]),c(1,27)]data2[,27] <- NULLLa variable Base est présente deux fois !
Même procédure, on observe des différences mais c’est seulement des problèmes de majuscules.
head(data2[c(!data2[,2]==data2[,22]),c(2,22)])data2[c(!tolower(data2[,2])==tolower(data2[,22])),c(2,22)]data2[,22] <- NULLEn particulier certaines méritent peut-être un pré-traitement, par exemple les noms des producteurs INSEE, DREES, CNAMTS écrit en plein texte.
head(sample(data2$Producteur))## [1] "Direction de la recherche des études de l’évaluation et des statistiques (DREES), Institut national de la statistique et des études économiques (Insee)"
## [2] "Agence technique de l'information sur l'hospitalisation (ATIH), Institut national de la statistique et des études économiques (Insee)"
## [3] "Institut national de la statistique et des études économiques (Insee)"
## [4] "Institut national de la santé et de la recherche médicale (Inserm), Institut national de la statistique et des études économiques (Insee)"
## [5] "Caisse Nationale de l'Assurance Maladie des Travailleurs Salariés (CNAMTS)"
## [6] "Direction de la recherche des études de l’évaluation et des statistiques (DREES), Institut national de la statistique et des études économiques (Insee)"Traitement des acronymes avec des expressions régulières
Commençons par une expression régulière pour récupérer le texte entre parenthèses (acronyme)
data2$producteur_acronyme=data2$Producteur%>%
stri_extract_all(regex = "(\\()([A-z]+)(\\))")%>%#On récupère LES chaînes de caractères entre parenthèses
lapply(function(x)paste(x,collapse=" "))%>%# On les colle
unlist%>%gsub(pattern = '(\\()|(\\))',replacement = '') # On met en vecteur et on supprime les parenthèses
data2[producteur_acronyme=="NA",producteur_acronyme:=Producteur]#On gère les noms sans acronyme
table(data2$producteur_acronyme)%>%head##
## Agence de l'eau Air Paca ANMDA
## 153 3 8 1
## ANSM ARS
## 1 254Même idée pour la source
data2$source_acronyme=data2$Source%>%
stri_extract_all(regex = "(\\()([A-z]+)(\\))")%>%#On récupère LES chaînes de caractères entre parenthèses
lapply(function(x)paste(x,collapse=" "))%>%# On les colle
unlist%>%gsub(pattern = '(\\()|(\\))',replacement = '') # On met en vecteur et on supprime les parenthèses
data2[source_acronyme=="NA",source_acronyme:=Source]#On gère les noms sans acronyme
table(data2$source_acronyme)%>%head##
## Accidents de la circulation
## 2283 3
## Adeli Adeli RPPS
## 9 13
## AGATA ALD
## 3 82Suppression des stop-words
Pour remplacer plusieurs mots d’un coup, stringr propose une fonction polymorphe très pratique str_replace_all. Lorsqu’on fournit un vecteur nommé à la place des paramètres pattern et replacement, la fonction est appliquée au vecteur de sorte que pour chaque entrée du vecteur, le nom joue le rôle de pattern et la valeur joue le rôle de replacement.
On commence par construire notre liste de stopwords.
stop_words = tm::stopwords(kind="fr")
# stop_words=c(stop_words,"actifs part entière APE")
stop_words=paste0(" ",stop_words," ")
stop_words=c(stop_words," c'"," l'"," d'"," j'"," t'"," m'"," s'")
fix_stop=rep(" ",length(stop_words))
names(fix_stop) <- stop_wordsPuis on passe en minuscules, on supprime les stopwords puis les espaces en trop.
data2 <- data2%>%
mutate(Indicateur=as.character(Indicateur))%>%#passage en char
mutate_if(is.character,tolower)%>%#en minuscules
mutate_if(is.character,function(x)str_replace_all(x,fix_stop))%>%#suppression de stopwords génériques et spécifiques
mutate_if(is.character,tm::stripWhitespace)#suppression des doubles espacesSuppression des colonnes constantes
cardinality=sapply(data2,function(x)length(unique(x)))
head(cardinality)## index
## 18885
## Base
## 25
## Indicateur
## 18360
## Famille
## 1933
## Famille Finale_DREES
## 1
## Classement producteur Niveau 3 (le plus détaillé)
## 410data2=data2[,cardinality>1]Construction du bloc de texte
data2$Indicateur_enriched=paste(data2$Indicateur,
data2$Famille,
data2$`Classement producteur Niveau 1 (le moins détaillé)`,
data2$`Classement producteur Niveau 2`,
data2$`Classement producteur Niveau 3 (le plus détaillé)`,
data2$source_acronyme,data2$producteur_acronyme)Longueur du texte :
nchar(data2$Indicateur)%>%hist(main="Distribution du nombre de caractères dans le texte")
On va compter les espaces pour se donner une idée du nombre de mots
str_count(data2$Indicateur," ")%>%hist(main="Distribution du nombre de mots dans le texte")
Les tags
Aperçu
Chaque indicateur taggé par machine learning a ensuite été validé par son producteur qui nous a renvoyé un fichier excel, ce qui fait une trentaine de fichiers Excel homogénéisés et empilés. On sautera cette étape et on travaillera directement sur le fichier intermédiaire : tagged_triplet_agreg.RData
load("tagged_triplet_agreg.RData")La fameuse liste des tags.
names(tagged)## [1] "index"
## [2] "Population_generale"
## [3] "Personnes_agees"
## [4] "Enfants__adolescents__jeunes_adultes"
## [5] "Population_precaire"
## [6] "Personnes_handicapees"
## [7] "Sante_des_femmes_perinatalite"
## [8] "Diabete_et_autres_maladies_endocriniennes"
## [9] "Sante_mentale"
## [10] "Cancer"
## [11] "Maladie_de_l_appareil_genito_urinaire"
## [12] "Maladies_cardiovasculaires"
## [13] "Maladies_neurologiques_ou_degeneratives"
## [14] "Maladies_respiratoires"
## [15] "Maladies_de_l_appareil_digestif"
## [16] "Maladies_infectieuses"
## [17] "Pathologies_du_systeme_osteo_articulaire"
## [18] "Traumatismes_et_pathologies_accidentelles"
## [19] "Autres_pathologies"
## [20] "Coordination_continuite"
## [21] "Qualite_et_securite_des_soins"
## [22] "Prevention_depistage"
## [23] "Accessibilite_geographique_financier_autres"
## [24] "Habitudes_de_vie_et_addictions"
## [25] "Determinants_environnementaux"
## [26] "E_sante_systemes_d_information"
## [27] "Droits_d_usagers_democratie_sanitaire"
## [28] "Mesures_d_inegalites_et_de_disparites_territoriales_de_sante"
## [29] "Contexte_demographique_et_socio_economique"
## [30] "Offre_de_soins"
## [31] "Offre_medico_sociale"
## [32] "Recours_aux_soins"
## [33] "Protection_sociale"
## [34] "Depenses_de_sante"
## [35] "Etat_de_sante"
## [36] "Determinants_professionnels"names(tagged) <- tolower(names(tagged))Pour l’instant on dispose d’un tableau avec une ligne par indicateur et pour chaque colonne un ‘top’ tag ie un booléen qui nous indique si le tag est appliqué.
head(tagged[,1:10])Nombre de tags par indicateur
Si on aime le jargon ADD (ACM) on peut parler de tableau disjonctif de la variable ‘tag’ à ceci près que plusieurs modalités sont possibles en même temps…
Justement, combien de tags par indicateur ?
rowSums(tagged%>%select(-index))%>%hist
Matrice sparse
La densité de la matrice de tags vaut 8.2 %.
On préfère le format triplet qui nous servira ensuite pour une représentation en matrice creuse (sparse)
tagged_triplet=reshape::melt(tagged,id.vars="index")
head(tagged_triplet)Machine Learning
[Prélude] Heuristiques pour le tagging
Pour l’instant on va seulement distinguer les indicateurs déjà taggés des autres et on va utiliser des distances sur chaînes de caractères pour labelliser par k-plus proches voisins.
Proximité entre noms d’indicateurs
Cosine
On commence par récupérer les vecteurs d’indicateurs et indices taggés/non-taggés.
table(indicateur_wtags$Base,indicateur_wtags$is_tagged)##
## FALSE TRUE
## ameli 3233 255
## atlas santé mentale france (atlasanté) 0 228
## balises 16 964
## base cépidc 10 238
## c@rtosanté 0 150
## data.drees 4907 4
## dépistage organisé cancers 2 178
## diamant 567 0
## etats financiers (ars) 5 247
## hospidiag 165 16
## hospitalisations brûlures 2 38
## indicateurs inca 0 674
## maladies déclaration obligatoire 0 54
## mortalité traumatismes 0 84
## observatoire fragilités grand nord 133 15
## observatoire fragilités grand sud 148 80
## odicer 0 678
## pqe at-mp 3 50
## pqe invalidité 3 61
## pqe maladie 23 246
## scansanté 140 1051
## scopesante 0 345
## score santé 2892 129
## sirsépaca 677 66
## sumer 0 188sub_index=indicateur_wtags[Base=="scansanté"]$index%>%as.character()
tagged_index=indicateur_wtags[index%in%sub_index&is_tagged]$index%>%as.character()
tagged_indicateurs=indicateur_wtags[index%in%sub_index&is_tagged]$Indicateur
to_tag_index=indicateur_wtags[index%in%sub_index&!is_tagged]$index%>%as.character()
to_tag_indicateurs=indicateur_wtags[index%in%sub_index&!is_tagged]$IndicateurLa matrice risque de ne pas tenir en RAM (plusieurs Gb), dans ce cas prenez un échantillon de dtm, par exemple on peut raisonner base par base, ou producteur par producteur.
i_sub=summary(dtm[sub_index,])$i
j_sub=summary(dtm[sub_index,])$j
dimnm_sub=dimnames(dtm[sub_index,])
dt_dtm=simple_triplet_matrix(i = i_sub, j=j_sub, v=rep(1,length(j_sub)), dimnames = dimnm_sub)
# sum(dt_dtm[sample(ncol(dt_dtm)*nrow(dt_dtm),10000)])On calcule manuellement la matrice de similarité cosine
similarity=tcrossprod_simple_triplet_matrix(dt_dtm)
similarity[1:10,1:10]## 7713 7714 7715 7716 7717 7718 7719 7720 7721 7722
## 7713 31 31 26 26 26 26 28 28 20 18
## 7714 31 37 26 26 26 26 28 28 20 18
## 7715 26 26 36 34 27 32 28 28 19 18
## 7716 26 26 34 35 27 32 27 27 19 18
## 7717 26 26 27 27 34 27 27 27 19 18
## 7718 26 26 32 32 27 35 27 27 19 18
## 7719 28 28 28 27 27 27 31 30 19 18
## 7720 28 28 28 27 27 27 30 37 19 18
## 7721 20 20 19 19 19 19 19 19 39 30
## 7722 18 18 18 18 18 18 18 18 30 55summary(c(similarity))## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000000 3.000000 5.000000 9.507469 13.000000 79.000000Il faut normaliser la matrice, cette étape est facultative parce que la version non normalisée est déjà exploitable.
diag_=diag(similarity)
diag_[1:10]## 7713 7714 7715 7716 7717 7718 7719 7720 7721 7722
## 31 37 36 35 34 35 31 37 39 55diag_=simple_triplet_diag_matrix(sqrt(1/diag_))
dimnames(diag_) <- list(dimnm_sub[[1]],dimnm_sub[[1]])
# diag_ * similarity * diag_
similarity=slam::matprod_simple_triplet_matrix(diag_,similarity)
similarity[1:10,1:10]## 7713 7714 7715 7716 7717
## 7713 5.567764363 5.567764363 4.669737853 4.669737853 4.669737853
## 7714 5.096368606 6.082762530 4.274373670 4.274373670 4.274373670
## 7715 4.333333333 4.333333333 6.000000000 5.666666667 4.500000000
## 7716 4.394802125 4.394802125 5.747048932 5.916079783 4.563832976
## 7717 4.458963214 4.458963214 4.630461799 4.630461799 5.830951895
## 7718 4.394802125 4.394802125 5.408987230 5.408987230 4.563832976
## 7719 5.028948457 5.028948457 5.028948457 4.849343155 4.849343155
## 7720 4.603171645 4.603171645 4.603171645 4.438772657 4.438772657
## 7721 3.202563076 3.202563076 3.042434922 3.042434922 3.042434922
## 7722 2.427119505 2.427119505 2.427119505 2.427119505 2.427119505
## 7718 7719 7720 7721 7722
## 7713 4.669737853 5.028948457 5.028948457 3.592106041 3.232895436
## 7714 4.274373670 4.603171645 4.603171645 3.287979746 2.959181771
## 7715 5.333333333 4.666666667 4.666666667 3.166666667 3.000000000
## 7716 5.408987230 4.563832976 4.563832976 3.211586168 3.042555317
## 7717 4.630461799 4.630461799 4.630461799 3.258473118 3.086974533
## 7718 5.916079783 4.563832976 4.563832976 3.211586168 3.042555317
## 7719 4.849343155 5.567764363 5.388159061 3.412500739 3.232895436
## 7720 4.438772657 4.931969619 6.082762530 3.123580759 2.959181771
## 7721 3.042434922 3.042434922 3.042434922 6.244997998 4.803844614
## 7722 2.427119505 2.427119505 2.427119505 4.045199175 7.416198487similarity=slam::matprod_simple_triplet_matrix(similarity,diag_)
similarity[1:10,1:10]## 7713 7714 7715 7716 7717
## 7713 1.0000000000 0.9153348228 0.7782896421 0.7893297629 0.8008534347
## 7714 0.9153348228 1.0000000000 0.7123956117 0.7225010187 0.7330490368
## 7715 0.7782896421 0.7123956117 1.0000000000 0.9578414887 0.7717436331
## 7716 0.7893297629 0.7225010187 0.9578414887 1.0000000000 0.7826908981
## 7717 0.8008534347 0.7330490368 0.7717436331 0.7826908981 1.0000000000
## 7718 0.7893297629 0.7225010187 0.9014978717 0.9142857143 0.7826908981
## 7719 0.9032258065 0.8267540335 0.8381580761 0.8196886000 0.8316554899
## 7720 0.8267540335 0.7567567568 0.7671952741 0.7502895194 0.7612432305
## 7721 0.5751973085 0.5264981265 0.5070724870 0.5142653639 0.5217732846
## 7722 0.4359235317 0.3990159887 0.4045199175 0.4102580753 0.4162475611
## 7718 7719 7720 7721 7722
## 7713 0.7893297629 0.9032258065 0.8267540335 0.5751973085 0.4359235317
## 7714 0.7225010187 0.8267540335 0.7567567568 0.5264981265 0.3990159887
## 7715 0.9014978717 0.8381580761 0.7671952741 0.5070724870 0.4045199175
## 7716 0.9142857143 0.8196886000 0.7502895194 0.5142653639 0.4102580753
## 7717 0.7826908981 0.8316554899 0.7612432305 0.5217732846 0.4162475611
## 7718 1.0000000000 0.8196886000 0.7502895194 0.5142653639 0.4102580753
## 7719 0.8196886000 1.0000000000 0.8858078930 0.5464374431 0.4359235317
## 7720 0.7502895194 0.8858078930 1.0000000000 0.5001732202 0.3990159887
## 7721 0.5142653639 0.5464374431 0.5001732202 1.0000000000 0.6477502756
## 7722 0.4102580753 0.4359235317 0.3990159887 0.6477502756 1.0000000000summary(c(similarity))## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.00000000 0.05773503 0.10189239 0.18410970 0.26919095 1.00000000On regarde ce que ça donne sur un exemple. On va cibler les indicateurs non-taggés avec la similarité la plus forte avec des indicateurs déjà taggés.
similarity_in_dataset=rowSums(similarity[to_tag_index,tagged_index])
to=names(which.max(similarity_in_dataset))
indicateur_wtags[index==as.numeric(to)]$Indicateur## [1] "had - nombre journées présence région"from=sort(similarity[to,tagged_index],decreasing = T)
from_nm=names(from)
indicateur_wtags[index%in%head(from_nm)]$Indicateur## [1] "had - nombre journées région"
## [2] "had - nombre journées présence sexe"
## [3] "had - nombre journées présence statut juridique"
## [4] "had - nombre journées présence hospitalisation complète région"
## [5] "had - nombre journées présence hospitalisation temps partiel région"
## [6] "had - evolution nombre journées présence région"indicateur_wtags[index%in%tail(from_nm)]$Indicateur## [1] "total entrées sorties établissements partenaires mco"
## [2] "sortie transfert (ou des) établissement(s) sélectionné(s) vers établisssments partenaires ssr"
## [3] "densité population (hab/km2)"
## [4] "part personnes moins 20 ans (%)"
## [5] "part personnes plus 75 ans (%)"
## [6] "evolution population depuis 2008 (%)"On applique cette logique à tous les indicateurs à tagger.
similarity2=similarity[to_tag_index,tagged_index]
similarity2[1:10,1:10]## 7713 7714 7715 7716 7717
## 7739 0.39794191946 0.36425009633 0.36927447294 0.37451267036 0.37998029783
## 7814 0.39349550147 0.36018013511 0.36514837167 0.37032803991 0.37573457465
## 7815 0.39349550147 0.36018013511 0.36514837167 0.37032803991 0.37573457465
## 7816 0.42268197221 0.38689552813 0.39223227028 0.39779612648 0.40360367640
## 7975 0.05296271413 0.04847861656 0.02457365936 0.02492223931 0.02528608687
## 7976 0.02514977274 0.04604092555 0.02333800140 0.02366905342 0.02401460532
## 7977 0.02540002540 0.04649905550 0.02357022604 0.02390457219 0.02425356250
## 7978 0.02540002540 0.04649905550 0.02357022604 0.02390457219 0.02425356250
## 7979 0.02514977274 0.02302046278 0.02333800140 0.02366905342 0.02401460532
## 7980 0.02619812585 0.02398005689 0.02431083192 0.02465568364 0.02501563966
## 7718 7719 7720 7721 7722
## 7739 0.37451267036 0.39794191946 0.36425009633 0.41391867719 0.34855071841
## 7814 0.37032803991 0.39349550147 0.36018013511 0.43852900965 0.39389277113
## 7815 0.37032803991 0.39349550147 0.36018013511 0.43852900965 0.39389277113
## 7816 0.39779612648 0.42268197221 0.38689552813 0.47105571977 0.39666441401
## 7975 0.02492223931 0.02648135707 0.02423930828 0.07082882470 0.05964320794
## 7976 0.02366905342 0.02514977274 0.02302046278 0.04484485293 0.05664411840
## 7977 0.02390457219 0.02540002540 0.02324952775 0.04529108137 0.05720775535
## 7978 0.02390457219 0.02540002540 0.02324952775 0.04529108137 0.05720775535
## 7979 0.02366905342 0.02514977274 0.02302046278 0.04484485293 0.05664411840
## 7980 0.02465568364 0.02619812585 0.02398005689 0.04671418359 0.05900529432order_sim=apply(similarity2,1,order,decreasing=T)%>%t
nb_cols=length(tagged_index)
similarity3=matrix(tagged_indicateurs[order_sim],ncol = nb_cols)
# Les 5 plus ressemblants et les 5 plus dissemblants
similarity3=similarity3[,c(1:5,(nb_cols-4):nb_cols)]
rownames(similarity3) <- to_tag_indicateurs
# View(t(similarity3))
t(similarity3)[,1:5]## dont cmp ouverts ? 5j / semaine ambulatoire selon psy. générale psy. infanto-juvénile
## [1,] "nombre cattp ambulatoire selon psy. générale psy. infanto-juvénile"
## [2,] "nombre cmp unités consultations ambulatoire selon psy. générale psy. infanto-juvénile"
## [3,] "nombre de structures ambulatoire selon psy. générale psy. infanto-juvénile"
## [4,] "nombre structures ateliers thérapeutiques temps partiel selon psy. générale psy. infanto-juvénile"
## [5,] "nombre places hdj temps partiel selon psy. générale psy. infanto-juvénile"
## [6,] "had - part nombre journées 20 premiers gme hospitalisation temps partiel"
## [7,] "had - age moyen patients 20 premiers gme hospitalisation temps partiel"
## [8,] "had - dépendance physique moyenne 20 premiers gme hospitalisation temps partiel"
## [9,] "had - dépendance cognitive moyenne 20 premiers gme hospitalisation temps partiel"
## [10,] "had - score réadaptation rééducation moyen 20 premiers gme hospitalisation temps partiel"
## psy recettes daf
## [1,] "nombre venues une journée"
## [2,] "nombre actes edga"
## [3,] "psy nombre patients soins consentement*"
## [4,] "psy pourcentage patients non originaires zone géographique implantation sélectionné"
## [5,] "psy nombre journées présence temps complet"
## [6,] "variation annuelle moyenne population période 5 ans (%)"
## [7,] "taux bénéficiaires cmu-c (tous régimes. 2015. fonds cmu)"
## [8,] "densité médecins généralistes spécialistes libéraux 100 000 habitants (2015, drees)"
## [9,] "population classe âge 1er janvier 2015 (estimation p)"
## [10,] "part population classe âge 2015"
## psy détail recettes daf
## [1,] "nombre venues une journée"
## [2,] "nombre actes edga"
## [3,] "psy nombre patients soins consentement*"
## [4,] "psy pourcentage patients non originaires zone géographique implantation sélectionné"
## [5,] "psy nombre journées présence temps complet"
## [6,] "variation annuelle moyenne population période 5 ans (%)"
## [7,] "taux bénéficiaires cmu-c (tous régimes. 2015. fonds cmu)"
## [8,] "densité médecins généralistes spécialistes libéraux 100 000 habitants (2015, drees)"
## [9,] "population classe âge 1er janvier 2015 (estimation p)"
## [10,] "part population classe âge 2015"
## psy recettes oqn
## [1,] "nombre venues une journée"
## [2,] "nombre actes edga"
## [3,] "psy nombre patients soins consentement*"
## [4,] "psy pourcentage patients non originaires zone géographique implantation sélectionné"
## [5,] "psy nombre journées présence temps complet"
## [6,] "had - part nombre journées 20 premiers gme hospitalisation temps partiel"
## [7,] "had - age moyen patients 20 premiers gme hospitalisation temps partiel"
## [8,] "had - dépendance physique moyenne 20 premiers gme hospitalisation temps partiel"
## [9,] "had - dépendance cognitive moyenne 20 premiers gme hospitalisation temps partiel"
## [10,] "had - score réadaptation rééducation moyen 20 premiers gme hospitalisation temps partiel"
## had nombre journées période selon "" patients domiciliés département"" ""établissements département""
## [1,] "ssr nombre journées (hc hp séances)"
## [2,] "ssr avq relationnel moyen"
## [3,] "ssr nombre moy actes csarr journée"
## [4,] "mco proportion malades masculins période type activité"
## [5,] "ssr sexe ratio (% homme)"
## [6,] "population 1er janvier"
## [7,] "taux bénéficiaires cmu-c (tous régimes. 2015. fonds cmu)"
## [8,] "densité médecins généralistes spécialistes libéraux 100 000 habitants (2015, drees)"
## [9,] "population classe âge 1er janvier 2015 (estimation p)"
## [10,] "part population classe âge 2015"Pour aller plus loin on pourrait mettre un seuil de similarité sur les indicateurs et utiliser les tags déjà appliqués pour prédire le tag.
to## [1] "8693"from_best=from[from>.7]
freq_tags=indicateur_wtags[index%in%as.numeric(names(from_best)),nm_tags,with=F]%>%colSums()/length(from_best)
sort(freq_tags,decreasing = T)## population_generale
## 1.000000000
## recours_aux_soins
## 1.000000000
## coordination_continuite
## 0.131147541
## personnes_agees
## 0.000000000
## enfants__adolescents__jeunes_adultes
## 0.000000000
## population_precaire
## 0.000000000
## personnes_handicapees
## 0.000000000
## sante_des_femmes_perinatalite
## 0.000000000
## diabete_et_autres_maladies_endocriniennes
## 0.000000000
## sante_mentale
## 0.000000000
## cancer
## 0.000000000
## maladie_de_l_appareil_genito_urinaire
## 0.000000000
## maladies_cardiovasculaires
## 0.000000000
## maladies_neurologiques_ou_degeneratives
## 0.000000000
## maladies_respiratoires
## 0.000000000
## maladies_de_l_appareil_digestif
## 0.000000000
## maladies_infectieuses
## 0.000000000
## pathologies_du_systeme_osteo_articulaire
## 0.000000000
## traumatismes_et_pathologies_accidentelles
## 0.000000000
## autres_pathologies
## 0.000000000
## qualite_et_securite_des_soins
## 0.000000000
## prevention_depistage
## 0.000000000
## accessibilite_geographique_financier_autres
## 0.000000000
## habitudes_de_vie_et_addictions
## 0.000000000
## determinants_environnementaux
## 0.000000000
## e_sante_systemes_d_information
## 0.000000000
## droits_d_usagers_democratie_sanitaire
## 0.000000000
## mesures_d_inegalites_et_de_disparites_territoriales_de_sante
## 0.000000000
## contexte_demographique_et_socio_economique
## 0.000000000
## offre_de_soins
## 0.000000000
## offre_medico_sociale
## 0.000000000
## protection_sociale
## 0.000000000
## depenses_de_sante
## 0.000000000
## etat_de_sante
## 0.000000000
## determinants_professionnels
## 0.000000000Ca a l’air de plutôt bien fonctionner… On en reste là pour cet technique de généralisation.
[Exercice] Distances entre strings
On a calculé “manuellement” les similarités cosine, maintenant utilisez le package stringdist pour calculer des distances entre les noms des indicateurs. Par exemple on pourra utiliser la fonction amatch
# A VOUS DE JOUER
methods=c("osa",
"lv",
"dl",
"hamming",
"lcs",
"qgram",
"cosine",
"jaccard",
"jw",
"soundex")On va maintenant passer à l’étape de construction du modèle de généralisation du tagging avec séparation des données en échantillons d’entraînement et de test.
Préparation
Echantillonnage train-test
On échantillonne sur les indicateurs et non directement sur les couples indicateurs x tags.
train_smp=sample(tagged_ids,size = round(.75*length(tagged_ids)))
test_smp = setdiff(tagged_ids, train_smp)
train_ind=rowSums(expand.grid((1:length(tags)-1)*nb_indicateurs,train_smp))
test_ind=rowSums(expand.grid((1:length(tags)-1)*nb_indicateurs,test_smp))Bases de train-test
On va sélectionner uniquement les colonnes pertinentes pour l’apprentissage pour ça on a recours à colSums pour vérifier si les colonnes sont constantes égales à 0.
Remarque : Cette pratique nous donne une piste pour l’active learning, on pourra demander au métier de tagger en priorité les indicateurs les moins bien représentés par le vocabulaire actuellement taggé
ngrams_tagged <- which(colSums(dtm_sp[c(train_ind,test_ind),])>0)
knowns_ind <- tagged_triplet[tagged_triplet$id%in%train_ind,][['i']]
train_ind <- train_ind[train_ind%in%knowns_ind]
train_ind <- sort(train_ind)
train_labels <- tagged_triplet[tagged_triplet$id%in%train_ind,]%>%
arrange(i)%>%.[['value']]
train_dtm <- dtm_sp[train_ind,ngrams_tagged]
dtrain <- xgb.DMatrix(data = as(train_dtm,"dgCMatrix"),
label = train_labels)
## Même chose pour le test qui va aussi nous servir de validation ici parce qu'on ne fait pas de gridsearch.
knowns_ind <- tagged_triplet[tagged_triplet$id%in%test_ind,][['i']]
test_ind <- test_ind[test_ind%in%knowns_ind]
test_ind <- sort(test_ind)
test_labels <- tagged_triplet[tagged_triplet$id%in%test_ind,]%>%
arrange(i)%>%.[['value']]
test_dtm <- dtm_sp[test_ind,ngrams_tagged]
dtest <- xgb.DMatrix(data = as(test_dtm,"dgCMatrix"),
label = test_labels)
watchlist <- list(train = dtrain,eval = dtest)Entraînement
On propose deux stratégies d’apprentissage, la première slow robuste et lente pour le modèle final, la seconde fast est plus rapide et “suffisante” pour évaluer le modèle régulièrement, une dernière superfast cherche à se rapprocher de l’instantanéité pour faire de l’active learning mais concrètement c’est difficile une fois qu’on n’est plus sur qqcentaines d’indicateurs taggés mais qqmilliers alors on se contente de 10-30 secondes.
timing="superfast"
if (timing=="slow"){
params=list(eta=.1,
max_depth=6,
min_child_weight=5,
subsample=500*length(tags)/length(train_ind),
colsample_bytree=8000/length(ngrams_tagged),
objective="binary:logistic",
eval_metric="auc",
gamma=.01)
nrounds=5E+3
} else if (timing=="fast"){
params=list(eta=.2,
max_depth=6,
min_child_weight=1,
subsample=500*length(tags)/length(train_ind),
colsample_bytree=1000/length(ngrams_tagged),
objective="binary:logistic",
eval_metric="auc",
gamma=.01)
nrounds=2E+2
} else if (timing=="superfast"){
params=list(eta=.1,
max_depth=3,
min_child_weight=1,
subsample=500*length(tags)/length(train_ind),
colsample_bytree=5000/length(ngrams_tagged),
objective="binary:logistic",
eval_metric="auc",
gamma=.01)
nrounds=1E+2
}On lance xgboost. Je vous invite à prendre le temps jouer sur les différentes paramètres, un gridsearch greedy sera trop long parce que chaque itération dure 30, 60, 120 secondes… mais essayer de jouer avec les paramètres 1 à 1 pour comprendre ce qui se passe.
Par exemple, on remarquera que le choix du colsample_bytree est décisif.
system.time(xgbmodel <- xgb.train(params = params,dtrain,
verbose = 1,print_every_n = 10,
nrounds = nrounds,watchlist,
early_stopping_rounds=200))
save(xgbmodel,file="trained_model.RData")load("trained_model.RData")Analyse des résultats
Importance des variables (ngrams)
Les ngrams précédés de __ sont ceux relatifs aux tags.
Le feature notions est la variable générée à partir du dictionnaire des notions. Elle devrait fonctionner à tous les coups mais on a vu que ce n’est pas toujours le cas.
Gain contribution of each feature to the model. For boosted tree model, each gain of each feature of each tree is taken into account, then average per feature to give a vision of the entire model. Highest percentage means important feature to predict the label used for the training (only available for tree models);
Cover metric of the number of observation related to this feature (only available for tree models);
Weight percentage representing the relative number of times a feature have been taken into trees.
imp=xgb.importance(feature_names = NULL,xgbmodel)
head(imp,30)Ngrams les plus importants par indicateur
get_imp_ngrams=data.table(i=i,j=j)
dico_ngrams=data.frame(j=1:max(j),ngram=dimnm[[2]])
get_imp_ngrams=merge(get_imp_ngrams,dico_ngrams,by="j")
get_imp_ngrams=merge(get_imp_ngrams,imp,by.x="ngram",by.y="Feature")
setorder(get_imp_ngrams,-Gain)
get_imp_ngrams[,order:=1:.N,by="i"]
get_imp_ngrams=get_imp_ngrams[order<=10]
get_imp_ngrams=dcast(get_imp_ngrams,i~order,value.var="ngram")
get_imp_ngrams=merge(get_imp_ngrams,data2[,c("index","Indicateur")],by.x="i",by.y="index")
sample_n(get_imp_ngrams%>%select(-i),10)On remarque que des stopwords nous ont échappé… mais manifestement ils n’étaient pas si “creux” puisque le modèle les a retenu.
Si on voit les choses autrement, on peut se dire que lorsque le ngram influent est un stopwords, les autres ngrams moins influents ne sont probablement pas pertinent. De plus si LE ngram le plus influent est un stopword, alors l’indicateur est probablement mal taggé…
Prédiction
Séparation des indicateurs non taggés
On construit la liste des indices des indicateurs dans la dtm qui sont déjà taggés et ne nécessitent donc pas de prédiction pour l’active learning.
Pour illustrer le contenu de cet objet, on fournit la liste des indices associés à l’indicateur numéro 8990 pour chaque couple indicateur x tag.
done_id=unique(c(test_ind,train_ind)%%nb_indicateurs)
max(done_id)## [1] 14350done_id=expand.grid((0:(length(tags)-1)*nb_indicateurs),done_id)%>%{.$Var1+.$Var2}
done_id%>%{.[.%%nb_indicateurs==8990]}## [1] 8990 27875 46760 65645 84530 103415 122300 141185 160070 178955
## [11] 197840 216725 235610 254495 273380 292265 311150 330035 348920 367805
## [21] 386690 405575 424460 443345 462230 481115 500000 518885 537770 556655
## [31] 575540 594425 613310 632195 651080Puis on extrait la dtm des indicateurs non taggés.
untagged_dtm=dtm_sp[setdiff(dimnames(dtm_sp)[[1]],as.character(done_id)),
ngrams_tagged]On vérifie qu’on retrouve bien tous nos 35 tags et que chaque tag a le même nombre d’indicateur. Lorsqu’on manipule les donner dans tous les sens il faut régulièrement vérifier qu’on n’a pas fait n’importe quoi.
table((as.numeric(dimnames(untagged_dtm)[[1]])-1)%/%nb_indicateurs)##
## 0 1 2 3 4 5 6 7 8 9 10 11
## 12926 12926 12926 12926 12926 12926 12926 12926 12926 12926 12926 12926
## 12 13 14 15 16 17 18 19 20 21 22 23
## 12926 12926 12926 12926 12926 12926 12926 12926 12926 12926 12926 12926
## 24 25 26 27 28 29 30 31 32 33 34
## 12926 12926 12926 12926 12926 12926 12926 12926 12926 12926 12926Prédiction pour les indicateurs non taggés
Le temps de prédiction dépend linéairement du nombre d’arbre dans le modèle, d’où le besoin de limiter le nombre d’arbres.
system.time(prediction <- predict(object=xgbmodel,
newdata = as(untagged_dtm,"dgCMatrix")))## user system elapsed
## 1.99 0.19 1.68pred <- data.frame(id=as.numeric(dimnames(untagged_dtm)[[1]]),
pred=prediction,notion=untagged_dtm[,"notions"])
pred=data.table(pred)On va hacker les predictions avec les notions. La variable notion est déjà codée TRUE/FALSE qui deviendra 1/0 par coercion en numérique, on peut donc la voir comme une proba/prédiction. On remarquera le recours à pmax pour le max sur les lignes.
pred$pred=pmax(pred$pred,pred$notion)Pour l’instant on a ça :
head(pred)Ces IDs ne sont pas très exploitables, on veut récupérer l’index du tag et de l’indicateur puis les noms des tags et indicateurs.
pred$tag_id=1+(as.numeric(as.character(pred$id))-1)%/%nb_indicateurs
pred$indic_id=1+(as.numeric(as.character(pred$id))-1)%%nb_indicateurs
nb_indicateurs_a_tagger=uniqueN(pred$indic_id)
nb_indicateurs_a_tagger## [1] 12926Maintenant on a ça :
head(pred)pred=merge(pred,tags_corres,by="tag_id")On ordonne pred par valeur de prediction puis par indicateur. Ainsi on pourra aisément récupérer les tags “favoris”
setorder(pred,-pred,indic_id)
pred$tags=as.character(pred$tags)Proba => Décision
Seuil sur la fréquence réelle (empirique)
On va calculer la fréquence réelle des tags dans la base puis la comparer avec la prédiction moyenne.
freq_tags=tagged_triplet[,list(frequence=mean(value)),by="variable"]
pred_with_freq=merge(pred,freq_tags,by.x="tags",by.y="variable")
nrow(pred_with_freq)/nrow(pred)# Si 1, alors jointure OK, sinon il y a un pb dans les noms des tags.## [1] 1pred_with_freq[,list(pred=mean(pred)),by="tags"]%>%merge(freq_tags,by.x="tags",by.y="variable")%>%ViewOn observe un décalage important entre prédiction moyenne et fréquence réelle pour certains indicateurs. Pour le moment on utilise les prédictions mais il va falloir “trancher” ie décider quelques tags sont appliqués et quels tags sont refusés ce qui nous donnera une fréquence davantage comparable à la fréquence réelle.
Par exemple si on prenait la décision de retenir les tags lorsque la prédiction est supérieure à X% de la fréquence empirique, on obtiendrait ces répartitions.
pred_with_freq[,list("nb_tags_applied"=mean(pred>frequence*.9)),by="tags"]%>%
merge(freq_tags,by.x="tags",by.y="variable")%>%
mutate(ratio=nb_tags_applied/frequence)%>%
{ggplot(.,aes(x=tags,label=ratio))+
geom_point(aes(y=nb_tags_applied),color="red")+
geom_point(aes(y=frequence),color="blue")+
theme(axis.text.x = element_blank())}%>%ggplotlyCette stratégie n’est pas très satisfaisante dans notre cas. On observe des ratios énormes x10, voire davantage.
Calage sur marge
Une fois encore on va s’appuyer sur la fréquence réelle et appliquer les tags aux indicateurs de sorte à garantir la cohérence des fréquences. Dans ce cas là c’est la distribution des tags par indicateur qui va nous inquiéter. Le métier nous a indiqué qu’il faudrait au moins 1 tag (la liste a été construite de façon à donner une vue exhaustive des thématiques de la santé) par indicateur et au plus 4-5.
pred_with_freq[,round(frequence*.N,0)[1],by="tags"]pred_with_freq[,rank:=1:.N,by="tags"]
nb_tags_per_indic=pred_with_freq[rank<=round(frequence*nb_indicateurs_a_tagger,0),
list(nb_tags=.N),by="indic_id"]
hist(nb_tags_per_indic$nb_tags)
table(nb_tags_per_indic$nb_tags)##
## 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
## 4330 3118 1750 729 473 221 130 169 129 129 155 105 32 102 92
## 16 17 18 19 20 21 22 23 24 25 26
## 39 30 7 27 12 8 11 14 22 11 3Cette méthode ne respecte pas les règles proposées par le métier. On compte des indicateurs avec aucun tag et d’autre avec une vingtaine de tags…
On souhaite comprendre pourquoi les tags sont ainsi distribués, est-ce que notre modèle est biaisé ?
nrow(nb_tags_per_indic)/nrow(pred_with_freq)# fraction des tags possibles attribués## [1] 0.0261886342nrow(nb_tags_per_indic)/nb_indicateurs_a_tagger# nombre moyen de tags par indicateur## [1] 0.9166021971# nb_tags_per_indic$indic_id[!nb_tags_per_indic$indic_id%in%pred$indic_id]
nb_tags_per_indic=merge(nb_tags_per_indic,data2[,c("index","Indicateur_enriched","Indicateur","Producteur","Producteur de la base")],by.x="indic_id",by.y="index")
setorder(nb_tags_per_indic,-nb_tags)
head(nb_tags_per_indic$Indicateur)## [1] "taux standardisé admission prématurée ald maladies infectieuses parasitaires (pop. réf. pse 2013) selon sexe"
## [2] "taux standardisé admission prématurée ald maladies infectieuses parasitaires (pop. réf. rp 2006) selon sexe"
## [3] "taux variation annuel moyen taux standardisé admission prématurée ald maladies infectieuses parasitaires (pop. réf. pse 2013) selon sexe"
## [4] "dépassements auxiliaires medicaux libéraux"
## [5] "honoraires dépassement chirurgiens dentistes libéraux spécialisés médecine bucco-dentaire actifs part entière (ape)"
## [6] "honoraires dépassement sages-femmes libérales actifs part entière (ape)"tail(nb_tags_per_indic$Indicateur)## [1] "répartition etp secteur pmi centres planification"
## [2] "répartition etp secteur aide sociale enfance"
## [3] "répartition etp secteur insertion"
## [4] "répartition etp secteur activités polyvalentes"
## [5] "répartition etp secteur activités générales diverses"
## [6] "répartition etp personnel action sociale médico-sociale"On se rend compte que les longs noms d’indicateurs semble davantage taggés, c’est un biais contre lequel on ne peut pas grand chose, notre modèle est basé sur la présence de mots clefs, plus un nom d’indicateur est long plus il peut contenir des mots clefs plus il peut être associé à des tags.
Vérifions cette intuition.
nb_tags_per_indic$nb_lettres_full=nchar(nb_tags_per_indic$Indicateur_enriched)
nb_tags_per_indic$nb_mots_full=str_count(nb_tags_per_indic$Indicateur_enriched," ")+1
nb_tags_per_indic$nb_lettres=nchar(nb_tags_per_indic$Indicateur)
nb_tags_per_indic$nb_mots=str_count(nb_tags_per_indic$Indicateur," ")+1
cor(nb_tags_per_indic[,c("nb_tags","nb_lettres","nb_mots")])## nb_tags nb_lettres nb_mots
## nb_tags 1.00000000000 0.03967351207 0.06719575451
## nb_lettres 0.03967351207 1.00000000000 0.95327898753
## nb_mots 0.06719575451 0.95327898753 1.00000000000cor(nb_tags_per_indic$nb_tags,nb_tags_per_indic$nb_mots,method = "pearson")## [1] 0.06719575451Corrélation 5% entre le nombre de tags et le nombre de mots, c’est positif mais faible.
Une autre hypothèse serait la pertinence du nommage par les producteurs, comparrons les taux de tagging par producteur.
stats_per_prod=nb_tags_per_indic[,list(volume=.N,moyenne=mean(nb_tags),decile1=quantile(nb_tags,.1),mediane=quantile(nb_tags,.5),decile9=quantile(nb_tags,.9)),by="Producteur de la base"]
setorder(stats_per_prod,-volume)
head(stats_per_prod,10)stats_per_prod$num=1:nrow(stats_per_prod)
stats_per_prod$`Producteur de la base`=reorder(stats_per_prod$`Producteur de la base`,-stats_per_prod$volume)
g <- ggplot(stats_per_prod[volume>100],aes(x=`Producteur de la base`,label=volume))+
geom_bar(aes(y=decile9),stat="identity",fill="#ff0000")+
geom_bar(aes(y=moyenne),stat="identity",fill="#ff6600")+
geom_bar(aes(y=mediane),stat="identity",fill="#ff9933")+
geom_bar(aes(y=decile1),stat="identity",fill="#ffcc00")+
theme(axis.text.x = element_blank(),axis.ticks.x = element_blank())
g%>%ggplotlyEntre la DREES, la CNAMTS et la FNORS qui sont les 3 plus gros producteurs, on observe des différences importantes dans le nombre de tags appliqués.
Une hypothèse pourrait être la différence de type d’indicateurs produits par la DREES comparée au reste de l’écosystème. Aucun indicateurs DREES n’étant taggé, il est probablement difficile d’appliquer les tags sur cet échantillon atypique.
Exercice 1 [manipulation de données]
Essayer d’implémenter une allocation qui respecte à la fois
- la contrainte de cohérence avec les fréquences réelles
- la contrainte d’allouer entre 1 et 5 tags par indicateur
** solution **
On commence par récupérer le tag favori pour chaque indicateur. Pour cela on crée un classement de tags par indicateur, le rank_tag==1 est le favori qu’on devra toujours garder.
setorder(pred_with_freq,-pred)
pred_with_freq[,rank_tag:=1:.N,by="indic_id"]pred_with_freq[,"nombre_a_allouer":=frequence*nb_indicateurs_a_tagger]
pred_with_freq[rank_tag==1,"deja_alloue_top1":=.N,by="tags"]
pred_with_freq[is.na(deja_alloue_top1),deja_alloue_top1:=0]favori=pred_with_freq[rank_tag==1]
reste=pred_with_freq[rank_tag>1&rank_tag<=5]
reste=reste[rank<=nombre_a_allouer-deja_alloue_top1]
choix_pred=rbind(favori,reste)On vérifie la fréquence des tags
choix_pred[,list(nb_tags_applied=.N/nb_indicateurs_a_tagger,frequence=frequence[1]),by="tags"]%>%
mutate(ratio=nb_tags_applied/frequence)%>%
{ggplot(.,aes(x=tags,label=ratio))+
geom_point(aes(y=nb_tags_applied),color="red")+
geom_point(aes(y=frequence),color="blue")+
theme(axis.text.x = element_blank())}%>%ggplotlychoix_pred=merge(choix_pred,data2[,c("index","Indicateur_enriched","Indicateur","Producteur","Producteur de la base")],by.x="indic_id",by.y="index")On vérifie la distribution des tags par indicateur
setnames(choix_pred,"Producteur de la base","Producteur_de_la_base")
stats_per_prod=choix_pred[
,list(nb_tags=.N,"Producteur_de_la_base"=Producteur_de_la_base[1]),
by="indic_id"]
table(stats_per_prod$nb_tags)##
## 1 2 3 4 5
## 4888 2858 2907 1322 951stats_per_prod=stats_per_prod[ ,list(volume=.N,
moyenne=mean(nb_tags),
decile1=quantile(nb_tags,.1),
mediane=quantile(nb_tags,.5),
decile9=quantile(nb_tags,.9)),
by="Producteur_de_la_base"]
setorder(stats_per_prod,-volume)
head(stats_per_prod,10)stats_per_prod$num=1:nrow(stats_per_prod)
stats_per_prod$Producteur_de_la_base=reorder(stats_per_prod$Producteur_de_la_base,-stats_per_prod$volume)
g <- ggplot(stats_per_prod[volume>100],aes(x=Producteur_de_la_base,label=volume))+
geom_bar(aes(y=decile9),stat="identity",fill="#ff0000")+
geom_bar(aes(y=moyenne),stat="identity",fill="#ff6600")+
geom_bar(aes(y=mediane),stat="identity",fill="#ff9933")+
geom_bar(aes(y=decile1),stat="identity",fill="#ffcc00")+
theme(axis.text.x = element_blank(),axis.ticks.x = element_blank())
g%>%ggplotlyExercice 2 [modélisation]
** Modéliser le nombre de tags à appliquer à un indicateur**
L’avantage de cette démarche est qu’elle peut être appliquée directement sur la dtm des indicateurs sans croisements avec les tags donc 35x moins de lignes… C’est l’occasion d’utiliser tout votre inventaire de modèles sur ce petit jeu de 6000 indicateurs taggés.
A VOUS DE JOUER !
Active Learning
Les applications shiny sont le support parfait pour créer une application d’active learning à fournir aux usagers métier.
Le squelette
Pour bien faire les choses on décompose l’application en 3 scripts ui.R server.R et global.R.
library(shiny)
runApp(list(
ui = fluidPage(title = "Tagging des indicateurs",
shiny::tags$h1("Tagging des indicateurs")
),
server = function(input, output) {
}
))L’indicateur à tagger
Mais avant d’appliquer des tags, il faut que l’utilisateur ait un indicateur à étudier.
### DANS LE global.R
library(DT)
indicateurs_pred$prob_sum=rowSums(indicateurs_pred[,paste0("prob_tag",1:5)])
setorder(indicateurs_pred,prob_sum)
var_a_afficher=c("Base","Indicateur","Famille",
"Classement producteur Niveau 1 (le moins détaillé)",
"Classement producteur Niveau 2",
"Classement producteur Niveau 3 (le plus détaillé)","source_acronyme","producteur_acronyme",paste0("tag",1:5))
# SERVER
servr=function(input, output) {
output$table=renderDT(datatable(indicateurs_pred[1,var_a_afficher,with=F]))
}
# UI
ui_carto = fluidPage(title = "Tagging des indicateurs",
shiny::tags$h1("Tagging des indicateurs"),
selectizeInput('tags', 'Choix des tags', choices=tags_corres$tags,multiple=T),
DTOutput("table")
)
runApp(list(
ui = ui_carto,
server = servr
))Autres interactions avec l’utilisateur
Ajout d’un bouton de validation, un autre bouton pour passer l’indicateur, un dernier pour relancer le modèle et la prédiction.
On ajoute des icones aux boutons en cherchant dans le catalogue font-awesome
# UI
ui_carto = fluidPage(title = "Tagging des indicateurs",
sidebarPanel(
shiny::tags$h1("Choix des tags"),
selectizeInput('tags', 'Choix multiples parmi 35', choices=tags_corres$tags,multiple=T),
actionButton("submit_tags","Valider",icon=icon("check-circle")),
actionButton("skip","Passer",icon=icon("fast-forward")),
actionButton("rerun","Re-Lancer",icon=icon("cogs"))
),
mainPanel(
shiny::tags$h1("L'indicateur à tagger"),
DTOutput("table"))
)
runApp(list(
ui = ui_carto,
server = servr
))Passer l’indicateur
Maintenant on passe à la logique côté serveur, plus complexe à gérer. On va commencer par le plus simple, passer l’indicateur et afficher le suivant. Pour cela on a besoin de gérer une liste d’indicateurs déjà traités (taggés ou passés). Pour cela on aura recours à des reactifs.
# SERVER
servr=function(input, output) {
index_done=reactiveVal(0)
output$table=renderDT(datatable(indicateurs_pred[!indic_id%in%index_done()][1,var_a_afficher,with=F]))
observeEvent(input$skip,{
curr_index=indicateurs_pred[!indic_id%in%index_done()][1]$indic_id
print("Ajout à la liste des indices traités")
print(curr_index)
index_done(c(index_done(),curr_index))
})
}
runApp(list(
ui = ui_carto,
server = servr
))